home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 48 / Amiga Format CD48 (1999-12-13)(Future Publishing)(GB)(Track 1 of 2)[!][issue 2000-01].iso / -in_the_mag- / workbench / html / 1st_linkchecker / extlinkchecker < prev    next >
Text File  |  1999-11-13  |  6KB  |  221 lines
  1. /* Optimized with RexxOpt 1.7 */
  2.  
  3. NL='0A'X
  4. TempFile="ram:HTMLfound"
  5. say "***************************************************"
  6. say "* External Link Checker V1.4 (09/09/97)           *"
  7. say "* © Heiko Schröder (age@thepentagon.com)          *"
  8. say "***************************************************"||NL
  9. if ~show('L',"rexxreqtools.library") then;do
  10. if ~addlib('rexxreqtools.library',0,-30,0) then;do
  11. say "You need LIBS:rexxreqtools.library. Cancel"
  12. Call Fini
  13. END
  14. END
  15. SIGNAL ON BREAK_C
  16. call rtezrequest("Which browser do you prefer?","AWeb|IBrowse|Cancel","» Select browser «",,fonttag "rtez_defaultresponse = 1",result)
  17. if result=1 then Browser="AWEB"
  18. if result=2 then Browser="IBROWSE"
  19. if result=0 then;do
  20. say "Cancel"
  21. exit
  22. end
  23. If Browser="AWEB" then;do
  24. Ports=Show('P')
  25. Parse Var Ports dummy 'AWEB.' portnr .
  26. If portnr='' then;do
  27. say "I cant check external links if AWEB isn't running!"
  28. say "Please start AWEB."
  29. Call Fini
  30. end
  31. end
  32. If Browser="IBROWSE" then;do
  33. Ports=Show('P')
  34. a=pos("IBROWSE",upper(Ports))
  35. If a=0 then;do
  36. say "I cant check external links if IBrowse isn't running!"
  37. say "Please start IBrowse."
  38. Call Fini
  39. end
  40. end
  41. verz=GetClip("xdir")
  42. call rtezrequest("Where can i check for links?","directory|file","» LinkChecker 1.4 «",,fonttag "rtez_defaultresponse = 1",result)
  43. if result=1 then;do
  44. dir=rtfilerequest(verz,,"Pick a directory and OK",,"rtfi_flags = freqf_nofiles")
  45. if rtresult=0 then;do
  46. echo "Cancel"
  47. Exit
  48. End
  49. pat="PAT=#?.#?(htm|html)"
  50. say "Checking: "||dir
  51. void=SetClip("xdir",dir)
  52. directory=dir
  53. if dir~="" then dir=d2c(34)||dir||d2c(34)
  54. address command "list >"TempFile dir pat||" quick nohead files all lformat %s%s"
  55. end
  56. else;do
  57. file=rtfilerequest(verz,,"Pick a file and OK",,)
  58. if rtresult=0 then;do
  59. echo "Cancel"
  60. Exit
  61. End
  62. Open("HTML",TempFile,"W")
  63. writeln("HTML",file)
  64. Close("HTML")
  65. pos=max(pos(":",file),lastpos("/",file))
  66. dir=Left(file,pos)
  67. say "Checking: "||dir
  68. void=SetClip("xdir",dir)
  69. end
  70. Time('R')
  71. Datei=0;Fehler=0;Links=0
  72. Open("LCR","T:LinkCheckResult","W")
  73. Open("HTML",TempFile,"R")
  74. DO WHILE 1
  75. htmlfile=ReadLn('HTML')
  76. IF EOF('HTML') THEN leave
  77. Datei=Datei+1
  78. ende=0
  79. zeile=0
  80. say d2c(11)||copies(" ",70)||d2c(11)
  81. say "Checking: "DelStr(htmlfile,1,length(directory))
  82. say "Files: "||Datei||" - Links: "||links||" - Errors: "||Fehler||""d2c(11)
  83. Open("CHECK",htmlfile,"R")
  84. DO WHILE ende=0
  85. Do WHILE ende=0
  86. line=Readln('CHECK')
  87. IF EOF('CHECK') THEN ende=1
  88. zeile=zeile+1
  89. if length(line)>7 then leave
  90. End
  91. DO WHILE 1
  92. pos1=max(lastpos('SRC=',upper(line)),lastpos('HREF=',upper(line)))
  93. IF pos1=0 then leave
  94. pos13=min(pos('=',line,pos1),pos('="',line,pos1))
  95. Select
  96. When pos13=0 then pos1=pos('=',line,pos1)
  97. When pos13<pos1+7 then pos1=pos13
  98. Otherwise NOP
  99. End
  100. link=Delstr(line,1,pos1)
  101. pos21=pos(d2c(34),link,2);if pos21=0 then pos21=99999
  102. pos22=pos(" ",link,2);if pos22=0 then pos22=99999
  103. pos23=pos("#",link,2);if pos23=0 then pos23=99999
  104. pos24=pos(">",link,2);if pos24=0 then pos24=99999
  105. pos2=min(pos21,pos22,pos23,pos24)
  106. IF pos2=99999 then leave
  107. line=Left(line,pos1-2)
  108. link=DelStr(link,pos2)
  109. link=strip(link,B,d2c(34))
  110. link=strip(link,B,"=")
  111. if pos(""",link)=0 then;do
  112. retrieve=1
  113. outlink=0
  114. if pos("HTTP://",upper(link)) ~=0 then outlink=1
  115. if pos("FTP://",upper(link)) ~=0 then outlink=1
  116. if pos("GOPHER://",upper(link)) ~=0 then outlink=1
  117. if pos("TELNET://",upper(link)) ~=0 then outlink=1
  118. if pos("ABOUT:",upper(link)) ~=0 then outlink=1
  119. if pos("FILE://",upper(link)) ~=0 then outlink=1
  120. if outlink=1 then;do
  121. If Browser="AWEB" then;do
  122. address value 'AWEB.'||portnr
  123. Open link
  124. Wait Doc
  125. SaveAs "T:LinkChecker.tmp"
  126. address 'REXX'
  127. Open("TMP","T:LinkChecker.tmp","R")
  128. extline=readln('TMP')
  129. Close("TMP")
  130. IF pos("<HTML><H1>ERROR</H1>",upper(extline))~=0 then retrieve=0
  131. end
  132. If Browser="IBROWSE" then;do
  133. address value 'IBROWSE'
  134. GotoUrl link
  135. a=result
  136. if a~=0 then retrieve=0
  137. end
  138. end
  139. else;do
  140. leave
  141. end
  142. links=links+1
  143. if retrieve=0 then;do
  144. Fehler=Fehler+1
  145. writeln("LCR",htmlfile||" -> "||link||" -> line: "||zeile)
  146. end
  147. say "Files: "||Datei||" - Links: "||links||" - Errors: "||Fehler||""d2c(11)
  148. end
  149. END
  150. END
  151. Close("CHECK")
  152. END
  153. Close("HTML")
  154. Close("LCR")
  155. Zeit=TIME('E')
  156. address command "delete ram:HTMLfound QUIET"
  157. address command "delete T:LinkChecker.tmp QUIET"
  158. say "Files: "||Datei||" - Links: "||links||" - Errors: "||Fehler||""
  159. If Fehler~=0 then
  160. say "Sorry. There were link errors. They are listed in T:LinkCheckResult."
  161. else
  162. say "Great. No external link errors :-)"
  163. SAY "Elapsed time: "Zeit" sec."
  164. Open("LCR","T:LinkCheckResult","R")
  165. z=0
  166. File.0=Fehler
  167. Link.0=Fehler
  168. Line.0=Fehler
  169. DO WHILE 1
  170. line=ReadLn('LCR')
  171. IF (EOF('LCR')|line='') THEN leave
  172. z=z+1
  173. pos1=pos(" -> ",line)
  174. pos2=pos(" -> ",line,pos1+1)
  175. File.z=Left(line,pos1)
  176. Link.z=Delstr(line,1,pos1+3);Link.z=Left(Link.z,pos2-pos1-4)
  177. Line.z=Delstr(line,1,pos2+9)
  178. End
  179. Close("LCR")
  180. if z=0 then Call Fini
  181. quit=0;del=0;t=1
  182. Do While quit=0
  183. call rtezrequest("Error: "t"/"Fehler||NL||" File: "File.t||NL||" Link: "Link.t||NL||" Line: "Line.t,"Prev|Next|I know|Leave","» Link Errors «",,fonttag "rtez_defaultresponse = 1",result)
  184. if (result=1&t~=1) then t=t-1
  185. if (result=2&t~=z) then t=t+1
  186. if result=3 then del=1
  187. if result=0 then quit=1
  188. if del=1 then;do
  189. if z~=t then;do
  190. do r=t to z-1
  191. e=r+1
  192. File.r=File.e
  193. Link.r=Link.e
  194. Line.r=Line.e
  195. end
  196. end
  197. else;do
  198. r=t-1
  199. t=t-1
  200. end
  201. File.0=r;if r=0 then quit=1
  202. Link.0=r
  203. Line.0=r
  204. z=z-1
  205. Fehler=Fehler-1
  206. del=0
  207. end
  208. End
  209. exit
  210. Fini:
  211. PARSE PULL Keyword
  212. exit
  213. BREAK_C:
  214. say Copies(" ",75)
  215. say "You have canceled."
  216. Close("CHECK")
  217. Close("HTML")
  218. Close("LCR")
  219. address command "delete ram:HTMLfound QUIET"
  220. Parse Pull Keyword
  221. Exit